home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / utility / 100 / label.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-01-16  |  20.5 KB  |  580 lines
  1.  
  2. PROGRAM Label_Maker ( input, output, p ) ;
  3.  
  4. {=============================================================================}
  5. {                                                                             }
  6. { Programme qui fabrique des etiquettes sur imprimantes, de n'importe quel    }
  7. { format et avec ou sans ligne(s) de texte preconcue(s).                      }
  8. {                                                                             }
  9. { Par Serge Vaillancourt,                                                     }
  10. { avril 1986,                                                                 }
  11. { Version 1.0.                                                                }
  12. {                                                                             }
  13. {=============================================================================}
  14.  
  15. CONST
  16.  
  17.    Desk_Item = 8 ;
  18.    Max_li = 25 ;
  19.    {$I gemconst.pas}
  20.  
  21. TYPE
  22.  
  23.    Tab_Texte = Array [1..Max_li] of string[80] ;
  24.    {$I gemtype.pas}
  25.  
  26. VAR
  27.  
  28.    P : text ;                   { Sortie vers imprimante }
  29.    Menu : Menu_Ptr;             { desktop }
  30.    Format,                      { menu }
  31.    Composer : integer ;         {  "   }
  32.    Form_Creer,                  { sous-menu }
  33.    Form_Sauver,                 {     "     }
  34.    Form_Charger,                {     "     }
  35.    Comp_Creer,                  {     "     }
  36.    Comp_Imprimer,               {     "     }
  37.    Comp_Quitter : integer ;     {     "     }
  38.    dummy : integer;             { parametres inutilises }
  39.    Nb_Lignes,                   { nombre de lignes sur l'etiquette }
  40.    Nb_Car : integer;            { nombre de caracteres par ligne }
  41.    F_Titre,                     { titre d'une fenetre }
  42.    W_Title : string ;           {           "         }
  43.    Larg_Etiq,                   { largeur en pouce de l'etiquette }
  44.    Haut_Etiq : real ;           { hauteur en pouce de l'etiquette }
  45.    EouP : Array [1..max_li] of char ;
  46.                                 { indique si ligne est Editable ou Permanente }
  47.    Texte_P : Tab_Texte ;        { texte permanent dans format }
  48.    Format_Exist : boolean ;     { verifie si un format est deja cree }
  49.  
  50. {=============================================================================}
  51.  
  52. {$I gemsubs.pas}
  53. procedure IO_Check ( b:boolean ) ; external ;
  54.  
  55. {=============================================================================}
  56.  
  57. procedure IDENTIFICATION ;
  58. {-----------------------------------------------------------------------------}
  59. { Pcd qui affiche le message du debut. Ce message peut aussi etre afficher    }
  60. { lors de la selection de LABEL_MAKER.                                        }
  61. {-----------------------------------------------------------------------------}
  62.  
  63. Var
  64.  
  65.    ok : integer ;               { valeur retourne par Do_Alert }
  66.    alert : string[255] ;        { message porter a l'ecran }
  67.  
  68. Begin
  69.  
  70.    alert := '[0][ LABEL MAKER V1.0 | Serge Vaillancourt | juin 86 ][ OK ]' ;
  71.    ok := Do_Alert ( alert, 1 ) ;
  72.    Menu_Normal ( Menu, 3 ) ;
  73.  
  74. End; { IDENTIFICATION }
  75.  
  76. {=============================================================================}
  77.  
  78. procedure REVOIR ( txt : Tab_Texte ) ;
  79. { Pcd qui permet de revoir la forme creee.                                    }
  80.  
  81. Var
  82.  
  83.    i : integer ;                { indice }
  84.  
  85. Begin
  86.  
  87.    writeln ; writeln ;
  88.    for i:=1 to Nb_Lignes do writeln ('Ligne', i:3, ' (', EouP[i], ') ---> ',
  89.                                         Txt[i] ) ;
  90.  
  91. End; { REVOIR }
  92.  
  93. {=============================================================================}
  94.  
  95. procedure CREATION_FORMAT ;
  96. {-----------------------------------------------------------------------------}
  97. { Pcd qui cree le format de l'etiquette.                                      }
  98. {-----------------------------------------------------------------------------}
  99.  
  100. Const
  101.  
  102.    nb_car_po = 10 ;             { 10 caracteres au pouce }
  103.    nb_ligne_po = 6 ;            { 6 lignes au pouce }
  104.  
  105. {.............................................................................}
  106.  
  107. procedure SIZE;
  108. { pcd qui determine le nombre de ligne et de caractares par ligne de          }
  109. { l'etiquette.                                                                }
  110.  
  111. Const
  112.  
  113.    max_larg = 6.0 ;             { largeur max d'une etiquette }
  114.    max_haut = 3.0 ;             { hauteur max d'une etiquette }
  115.  
  116. Var
  117.  
  118.    flag : boolean ;             { si entree est conforme }
  119.  
  120. Begin { SIZE }
  121.  
  122.    writeln ( 'CREATION DU FORMAT' ) ;
  123.    writeln ( '------------------' ) ;
  124.    writeln ; writeln ;
  125.    write ( 'Largeur de l''etiquette : ' ) ;
  126.    repeat
  127.       readln ( Larg_Etiq ) ;
  128.       if Larg_Etiq > max_larg then
  129.       begin
  130.          flag := false ;
  131.          write ( '   Le maximum permis est de', max_larg :4:1, ' pouces : ' ) ;
  132.       end { if Larg_Etiq }
  133.       else if Larg_Etiq < 0.5 then
  134.       begin
  135.          flag := false ;
  136.          write ( '   Le minimum permis est de 0.5 pouce : ' ) ;
  137.       end { else if }
  138.            else flag := true ;
  139.    until flag = true ;
  140.    write ( 'Hauteur de l''etiquette : ' ) ;
  141.    repeat
  142.       readln ( Haut_Etiq ) ;
  143.       if Haut_Etiq > max_haut then
  144.       begin
  145.          flag := false ;
  146.          write ( '   Le maximum permis est de', max_haut :4:1, ' pouces : ' ) ;
  147.       end { if Haut_Etiq }
  148.       else if Haut_Etiq < 0.35 then
  149.       begin
  150.          write ( '   le minimum permis est de 0.35 pouce : ' ) ;
  151.          flag := false ;
  152.       end { else if }
  153.            else flag := true ;
  154.    until flag = true ;
  155.    writeln ;
  156.    Nb_Lignes := ( trunc ( nb_ligne_po * Haut_Etiq ) - 1 ) ;
  157.    Nb_Car := ( trunc ( nb_car_po * Larg_Etiq ) - 3 ) ;
  158.    writeln ( 'Votre etiquette permet', Nb_Lignes :3, ' lignes et', Nb_Car :3,
  159.              ' caracteres par ligne.' ) ;
  160.  
  161. End; { SIZE }
  162.  
  163. {.............................................................................}
  164.  
  165. procedure FORME_EDIT ( li : integer ) ;
  166. { Pcd qui edite les lignes de texte permanentes.                              }
  167.  
  168. Var
  169.  
  170.    j : integer ;                { indice }
  171.  
  172. Begin { FORME_EDIT }
  173.  
  174.    repeat
  175.       write ( 'Ligne', li:3, ' [E]ditable ou [P]ermanente : ' ) ;
  176.       readln ( EouP[li] ) ;
  177.    until ( EouP[li] = 'E' ) or ( EouP[li] = 'P' ) or ( EouP[li] = 'e' ) or
  178.          ( EouP[li] = 'p' ) ;
  179.    if ( EouP[li] = 'P' ) or ( EouP[li] = 'p' ) then
  180.    begin
  181.       write ( '         ' ) ;
  182.       for j := 1 to Nb_Car do write ( '.' ) ;
  183.       writeln ;
  184.       write ( '         ' ) ;
  185.       readln ( Texte_P[li] ) ;
  186.       for j := ( Nb_Car + 1 ) to 80 do Texte_P[li,j] := ' ' ;
  187.    end { if EouP }
  188.    else Texte_P[li] := ' ' ;
  189.  
  190. End; { FORME_EDIT }
  191.  
  192. {.............................................................................}
  193.  
  194. procedure FORME ;
  195. { Pcd qui cree la forme de l'etiquette, avec entree des lignes de texte       }
  196. { permanentes.                                                                }
  197.  
  198. Var
  199.  
  200.    i : integer ;                 { indice }
  201.  
  202. Begin { FORME }
  203.  
  204.    for i := 1 to Nb_Lignes do
  205.    begin
  206.       EouP[i] := ' ' ;           
  207.       Texte_P[i] := ' ' ;          
  208.    end; { for i }
  209.    writeln ; writeln ;
  210.    writeln ( 'ENTREZ ICI LES LIGNES DE TEXTE PERMANENTES...' ) ;
  211.    writeln ;
  212.    for i := 1 to Nb_Lignes do FORME_EDIT ( i ) ;
  213.  
  214. End; { FORME }
  215.  
  216. {.............................................................................}
  217.  
  218. procedure FORME_OK ;
  219. { Pcd qui affiche le format de l'etiquette et qui permet de corriger.         }
  220.  
  221. Var
  222.  
  223.    c : char ;                   { Edit ou Ok }
  224.    i, j,                        { indice }
  225.    no_li : 1..max_li ;          { no de ligne a coriger }
  226.    flag : boolean ;             { indique si no.ligne a edit est conforme }
  227.  
  228. Begin { FORME_OK }
  229.  
  230.    repeat
  231.       REVOIR ( Texte_P ) ;
  232.       writeln ;
  233.       repeat
  234.          write ( '[E]diter  [R]evoir  [O]k : ' ) ;
  235.          readln ( c ) ;
  236.       until ( c = 'E' ) or ( c = 'O' ) or ( c = 'R' ) or ( c = 'e' )
  237.             or ( c = 'o' ) or ( c = 'r' ) ;
  238.       if ( c = 'E' ) or ( c = 'e' ) then
  239.       begin
  240.          writeln ;
  241.          write ( 'Ligne no : ' ) ;
  242.          repeat
  243.             readln ( no_li ) ;
  244.             if no_li > Nb_Lignes then
  245.             begin
  246.                flag := false ;
  247.                write ( '   no de ligne de 1 @', Nb_Lignes :3, ' : ' ) ;
  248.             end { if no_li }
  249.             else flag := true ;
  250.          until flag = true ;
  251.          FORME_EDIT ( no_li ) ;
  252.       end { if c = 'E' }
  253.    until ( c = 'O' ) or ( c = 'o' ) ;
  254.  
  255. End; { FORME_OK }
  256.  
  257. {.............................................................................}
  258.  
  259. Begin { CREATION_FORMAT }
  260.  
  261.    Hide_Mouse ; { souris disparait }
  262.    Erase_Menu ( Menu ) ;        { efface le menu }
  263.    Clear_Screen;                { efface l'ecran }
  264.    Format_Exist := true ;       { indique qu'il existe maintenant un format }
  265.    SIZE ;
  266.    FORME ;
  267.    FORME_OK ;
  268.    Clear_Screen ;
  269.    Draw_Menu ( Menu ) ;         { replace le menu }
  270.    Show_Mouse ; { fait reaparaitre la souris }
  271.    Menu_Normal ( Menu, Format ) ; { eteint le menu FORMAT }
  272.  
  273. End; { CREATION_FORMAT }
  274.  
  275. {=============================================================================}
  276.  
  277. procedure DO_MENU ;
  278. {-----------------------------------------------------------------------------}
  279. { Pcd qui affiche le menu a l'ecran.                                          }
  280. {-----------------------------------------------------------------------------}
  281.  
  282. Begin
  283.  
  284.    Menu := New_Menu ( 10, '  LABEL MAKER  ' ) ;
  285.                                 { titre du DESK }
  286.    Format := Add_MTitle ( Menu, ' Format ' ) ;
  287.                                 { menu pour le format de l'etiquette }
  288.    Composer := Add_MTitle ( Menu, ' Composer ' ) ;
  289.                                 { menu pour composer une etiquette }
  290.    Form_Creer := Add_MItem ( Menu, Format, ' Creer      ' ) ;
  291.                                 { sous-menu pour creer un format }
  292.    Form_Sauver := Add_MItem ( Menu, Format, ' Sauver     ' ) ;
  293.                                 { sous-menu pour sauver un format sur disque }
  294.    Form_Charger := Add_MItem ( Menu, Format, ' Charger    ' ) ;
  295.                                 { sous-menu pour charger un format }
  296.    Comp_Creer := Add_MItem ( Menu, Composer, ' Creer      ' ) ;
  297.                                 { sous-menu pour creer une etiquette }
  298.    Comp_Imprimer := Add_MItem ( Menu, Composer, ' Imprimer   ' ) ;
  299.                                 { sous-menu pour imprimer une etiquette }
  300.    Comp_Quitter := Add_MItem ( Menu, Composer, ' Quitter    ' ) ;
  301.                                 { sous-menu pour retourner au DESKTOP }
  302.  
  303. End; { DO_MENU }
  304.  
  305. {=============================================================================}
  306.  
  307. procedure SAUVER_FORMAT ;
  308. {-----------------------------------------------------------------------------}
  309. { Pcd qui sauve sur disque le format de l'etiquette                           }
  310. {-----------------------------------------------------------------------------}
  311.  
  312. Var
  313.  
  314.    File_ok : boolean ;          { indique si cliquer OK ou CANCEL }
  315.    F : text ;                   { fichier logique pour format }
  316.    i,                           { indice }
  317.    ok : integer ;               { valeur retournee par Do_Alert }
  318.    defaut,                      { nom de fichier par defaut }
  319.    file_name : Path_Name ;      { nom veritable du fichier }
  320.  
  321. Begin
  322.  
  323.    if not ( Format_exist ) then
  324.    begin
  325.       ok := Do_Alert ( '[3][  IL N''Y A PAS DE FORMAT DEJA CREE ][ OK ]', 1 );
  326.       Clear_Screen ;
  327.       Draw_Menu ( Menu ) ;
  328.    end 
  329.    else
  330.    begin
  331.       defaut := 'A:*.FMT' ;
  332.       file_name := 'DEFAUT.FMT' ;
  333.       File_ok := Get_In_File ( defaut, file_name ) ;
  334.       if File_ok then
  335.       begin
  336.          rewrite ( F, file_name ) ;
  337.          writeln ( F, Nb_Lignes ) ;
  338.          writeln ( F, Nb_Car ) ;
  339.          for i := 1 to Nb_Lignes do
  340.          begin
  341.             writeln ( F, EouP[i] ) ;
  342.             writeln ( F, Texte_P[i] ) ;
  343.          end; { for i }
  344.          close ( F ) ;
  345.          Hide_Mouse ; Clear_Screen ; Draw_Menu ( menu ) ; Show_Mouse ;
  346.       end; { if File_ok }
  347.    end; { else }
  348.    Menu_Normal ( Menu, Format ) ; { eteint le menu FORMAT }
  349.  
  350. End; { SAUVER_FORMAT }
  351.  
  352. {=============================================================================}
  353.  
  354. procedure CHARGE_FORMAT ;
  355. {-----------------------------------------------------------------------------}
  356. { Pcd qui charge en memoire un format existant sur disque.                    }
  357. {-----------------------------------------------------------------------------}
  358.  
  359. Var
  360.  
  361.    File_ok : boolean ;          { indique si cliquer OK ou CANCEL }
  362.    F : text ;                   { fichier logique pour format }
  363.    i,                           { indice de boucle }
  364.    ok : integer ;               { valeur retournee par Do_Alert }
  365.    defaut,                      { nom de fichier par defaut }
  366.    file_name : Path_Name ;      { nom veritable du fichier }
  367.  
  368. Begin
  369.  
  370.    defaut := 'A:\*.FMT' ;
  371.    File_ok := Get_In_File ( defaut, file_name ) ;
  372.    if File_ok then
  373.    begin
  374.       Format_Existe := true ; { indique qu'il y un format en memoire }
  375.       reset ( F, file_name ) ;
  376.       readln ( F, Nb_Lignes ) ;
  377.       readln ( F, Nb_Car ) ;
  378.       for i := 1 to Nb_Lignes do
  379.       begin
  380.          readln ( F, EouP[i] ) ;
  381.          readln ( F, Texte_P[i] ) ;
  382.       end; { for i }
  383.       close ( F ) ;
  384.    end; { if File_ok }
  385.    Hide_Mouse ; Clear_Screen ; Draw_Menu ( menu ) ; Show_Mouse ;
  386.    Menu_Normal ( menu, Format ) ; { Eteint le menu FORMAT }
  387.  
  388. End; { CHARGE_FORMAT }
  389.  
  390. {=============================================================================}
  391.  
  392. procedure COMPOSITION ;
  393. {-----------------------------------------------------------------------------}
  394. { Pcd qui permet a l'usager de composer une etiquette.                        }
  395. {-----------------------------------------------------------------------------}
  396.  
  397. Var
  398.  
  399.    i, j, k, l : integer ;       { indices }
  400.    flag : boolean ;             { indique s'il y au moins une ligne editable }
  401.    ouiounon : char ;            { dans quest. "Autre modification (o/n) ?" }
  402.    ok : integer ;               { valeur retournee par Do_Alert }
  403.  
  404. Begin
  405.  
  406.    if not ( Format_Existe ) then
  407.    begin
  408.       ok := Do_Alert ( '[3][ IL N''Y A PAS DE FORMAT EN MEMOIRE ][ OK ]', 1 );
  409.       Clear_Screen ;
  410.       Draw_Menu ( Menu ) ;
  411.    end 
  412.    else
  413.    begin
  414.       Hide_Mouse ; 
  415.       flag := false ;           { initialise }
  416.       Clear_Screen ;           
  417.       writeln ( 'COMPOSITION D''UNE ETIQUETTE' ) ;
  418.       writeln ( '---------------------------' ) ;
  419.       REVOIR ( Texte_P ) ;
  420.       repeat
  421.          writeln ;
  422.          for i := 1 to Nb_Lignes do
  423.             if ( EouP[i] = 'E' ) or ( EouP[i] = 'e' ) then
  424.             begin
  425.                flag := true ;
  426.                write ( 'Ligne', i:3, ' ' ) ;
  427.                for j := 1 to Nb_Car do write ( '.' ) ;
  428.                writeln ;
  429.                write ( '         ' );
  430.                readln ( Texte_P[i] ) ;
  431.             end; { if EouP }
  432.          writeln ;
  433.          if not(flag) then
  434.          begin
  435.             writeln ( '~~~ Il n''y a pas de ligne editable ',
  436.                                      'dans ce format ~~~' ) ;
  437.             for k := 1 to 12 do         { temps affichage message }
  438.                for l := 1 to 30000 do ;   {   "      "        "     }
  439.             ouiounon := 'n' ; (* pour boucler la boucle REPEAT *)
  440.          end { if not(flag) }
  441.          else
  442.          begin
  443.             REVOIR ( Texte_P ) ;
  444.             writeln ;
  445.             repeat
  446.                write ('Autre modification (o/n) ? ') ;
  447.                readln ( ouiounon ) ;
  448.             until ( ouiounon = 'o' ) or ( ouiounon = 'O' ) or
  449.                   ( ouiounon = 'n' ) or ( ouiounon = 'N' ) ;
  450.          end ; { else }
  451.       until ( ouiounon = 'n' ) or ( ouiounon = 'N' ) ;
  452.       Clear_Screen ;
  453.       Draw_Menu ( menu ) ;
  454.       Show_Mouse ; { fait reaparaitre la souris }
  455.    end ; { else }
  456.    Menu_Normal ( Menu, Composer ) ; { eteint le menu COMPOSER }
  457.  
  458. End ; { COMPOSITION }
  459.  
  460. {=============================================================================}
  461.  
  462. procedure IMPRIME ;
  463. {-----------------------------------------------------------------------------}
  464. { Pcd qui imprime, autant de fois signale, le LABEL.                          }
  465. {-----------------------------------------------------------------------------}
  466.  
  467. Var
  468.  
  469.    i,j,                { indices }
  470.    Nb_fois : integer ; { nombre de label a imprimer }
  471.    On_line : string [2] ;
  472.    ok : integer ;      { valeur retourne par Do_Alert }
  473.  
  474. Begin
  475.  
  476.    if Format_exist then
  477.    begin
  478.       Hide_Mouse ; 
  479.       Clear_Screen ;      
  480.       writeln ( 'IMPRIMER L''ETIQUETTE' ) ;
  481.       writeln ( '====================' ) ;
  482.       writeln ;
  483.       writeln ( 'Mettez l''imprimante ON-LINE et tapez OK' ) ;
  484.       writeln ( 'ou appuyez sur Q pour retourner au menu' ) ;
  485.       readln ( On_line ) ;
  486.       while ( On_line <> 'OK' ) and ( On_line <> 'ok' ) and ( On_line <> 'Q' )
  487.             and ( On_line <> 'q' ) and ( On_line <> 'Ok' ) do
  488.       begin
  489.          writeln ( 'OK pour ON-LINE ou Q pour retour au menu' ) ;
  490.          readln ( On_line ) ;
  491.       end; { while }
  492.       if ( On_line = 'OK' ) or ( On_line = 'ok' ) or ( On_line = 'Ok' ) then
  493.       begin
  494.          rewrite ( P, 'PRN:' ) ;
  495.          writeln ;
  496.          write ( 'Indiquez le nombre d''etiquette a imprimer : ' ) ;
  497.          readln ( Nb_fois ) ;
  498.          for i := 1 to Nb_fois do
  499.          begin
  500.             for j := 1 to Nb_lignes do
  501.                writeln ( P, Texte_P[j] ) ; { ecrit chaque ligne }
  502.             writeln (P); { passe une ligne pour positionner tete ecriture a la
  503.                            premiere ligne de l'autre etiquette }
  504.          end ; { for i }
  505.       end ; { if }
  506.    end { if Format_Exist }
  507.    else { if Format_Exist }
  508.       ok := Do_Alert ( '[3][IL N''Y A PAS DE FORMAT EN MEMOIRE][OK]', 1) ;
  509.    Clear_Screen ;
  510.    Draw_Menu ( menu ) ;
  511.    Show_Mouse ; { fait reaparaitre la souris }
  512.    Menu_Normal ( Menu, Composer ) ; { eteint le menu COMPOSER }
  513.  
  514. End ; { IMPRIME }
  515.  
  516. {=============================================================================}
  517.  
  518. procedure EXECUTE_MENU ( title, item : integer ) ;
  519. {-----------------------------------------------------------------------------}
  520. { Pcd executant les choix au menu.                                            }
  521. {-----------------------------------------------------------------------------}
  522.  
  523. Begin
  524.  
  525.    if item = Desk_Item  then             IDENTIFICATION
  526.    else if item = Form_Creer then        CREATION_FORMAT
  527.    else if item = Form_Sauver then       SAUVER_FORMAT
  528.    else if item = Form_Charger then      CHARGE_FORMAT
  529.    else if item = Comp_Creer then        COMPOSITION
  530.    else if item = Comp_Imprimer then     IMPRIME
  531.  
  532. End; { EXECUTE_MENU }
  533.  
  534. {=============================================================================}
  535.  
  536. procedure EVENT_LOOP ;
  537. {-----------------------------------------------------------------------------}
  538. { Pcd bouclant jusqu'a ce que l'usager choisisse de quitter le pgm.           }
  539. {-----------------------------------------------------------------------------}
  540.  
  541. Var
  542.  
  543.    choix : integer ;            { valeur retournee par Get_Event }
  544.    msg : Message_Buffer ;       { messages retournes par GEM }
  545.  
  546. Begin
  547.  
  548.    repeat
  549.       choix := Get_Event ( E_Message, 0, 0, 0, 0, false, 0, 0, 0, 0, false, 0,
  550.                            0, 0, 0, msg, dummy, dummy, dummy, dummy, dummy,
  551.                            dummy ) ;
  552.                                 { attend un action de l'utilisateur }
  553.       EXECUTE_MENU ( msg[3], msg[4] ) ;
  554.                                 { execute le choix de l'utilisateur }
  555.    until msg[4] = Comp_Quitter ;     { jusqu'a ce qu'il choisisse de quitter }
  556.  
  557. End; { EVENT_LOOP }
  558.  
  559. {=============================================================================}
  560.  
  561. BEGIN { principal }
  562.  
  563.    if Init_Gem >= 0 then        { verifie si erreur dans l'appel du GEM }
  564.    begin
  565.       IO_Check( false ) ;       { empeche terminer  pgm si erreur IO }
  566.       Format_Exist := false ;   { initialise }
  567.       DO_MENU ;                 { cree le menu }
  568.       Hide_Mouse ;              { fait disparaitre la souris }
  569.       Clear_Screen ;            { efface l'ecran }
  570.       Draw_Menu ( Menu ) ;      { affiche le menu }
  571.       Show_Mouse ;              { fait apparaitre la souris }
  572.       IDENTIFICATION ;          { message du debut }
  573.       Event_Loop ;              { coeur du pgm }
  574.       Erase_Menu ( MENU ) ;     { efface le menu }
  575.       Exit_Gem ;                { retourne au DESKTOP }
  576.    end; 
  577.  
  578. END.
  579.  
  580. əəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəə